home *** CD-ROM | disk | FTP | other *** search
- /* evterm.f -- translated by f2c (version of 3 February 1990 3:36:42).
- You must link the resulting object file with the libraries:
- -lF77 -lI77 -lm -lc (in that order)
- */
-
- #include "f2c.h"
-
- /*< subroutine evterm(val,arg,iexp) >*/
- /* Subroutine */ int evterm_(val, arg, iexp)
- doublereal *val, *arg;
- integer *iexp;
- {
- /* Builtin functions */
- double log(), exp(), d_sign();
-
- /* Local variables */
- static integer jexp;
- static doublereal argexp;
-
- /*< implicit double precision (a-h,o-z) >*/
-
- /* this routine evaluates one term of a polynomial. */
-
- /*< jexp=iexp+1 >*/
- jexp = *iexp + 1;
- /*< if (jexp.ge.6) go to 60 >*/
- if (jexp >= 6) {
- goto L60;
- }
- /*< go to (10,20,30,40,50), jexp >*/
- switch (jexp) {
- case 1: goto L10;
- case 2: goto L20;
- case 3: goto L30;
- case 4: goto L40;
- case 5: goto L50;
- }
- /*< 10 val=1.0d0 >*/
- L10:
- *val = 1.;
- /*< go to 100 >*/
- goto L100;
- /*< 20 val=arg >*/
- L20:
- *val = *arg;
- /*< go to 100 >*/
- goto L100;
- /*< 30 val=arg*arg >*/
- L30:
- *val = *arg * *arg;
- /*< go to 100 >*/
- goto L100;
- /*< 40 val=arg*arg*arg >*/
- L40:
- *val = *arg * *arg * *arg;
- /*< go to 100 >*/
- goto L100;
- /*< 50 val=arg*arg >*/
- L50:
- *val = *arg * *arg;
- /*< val=val*val >*/
- *val *= *val;
- /*< go to 100 >*/
- goto L100;
- /*< 60 if (arg.eq.0.0d0) go to 70 >*/
- L60:
- if (*arg == 0.) {
- goto L70;
- }
- /*< argexp=dble(iexp)*dlog(dabs(arg)) >*/
- argexp = (doublereal) (*iexp) * log((abs(*arg)));
- /*< if (argexp.lt.-200.0d0) go to 70 >*/
- if (argexp < -200.) {
- goto L70;
- }
- /*< val=dexp(argexp) >*/
- *val = exp(argexp);
- /*< if((iexp/2)*2.eq.iexp) go to 100 >*/
- if (*iexp / 2 << 1 == *iexp) {
- goto L100;
- }
- /*< val=dsign(val,arg) >*/
- *val = d_sign(val, arg);
- /*< go to 100 >*/
- goto L100;
- /*< 70 val=0.0d0 >*/
- L70:
- *val = 0.;
-
- /* finished */
-
- /*< 100 return >*/
- L100:
- return 0;
- /*< end >*/
- } /* evterm_ */
-
-